home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / comm / fido / shelter191a.lha / rexx / Grab.WPLRX < prev    next >
Text File  |  1994-08-03  |  25KB  |  769 lines
  1. /**/ 
  2. v="$VER: GRAB Wplrx  Roof Remote File Xfer Utility        Williamson 54.55"
  3.  
  4. /* The number of requests permitted per call. Note some magic names */
  5. /* may return more than one file. Each magic name is counted as one */
  6. maxfiles=3
  7.  
  8. /* maximum number of files and sessions for a verified user         */
  9. maxpsessions=10
  10.  
  11. /* your list of files recd in last week */
  12. newfiles="Mail:filelists/newfiles.lst"
  13.  
  14. /* help files for new users */
  15. newinfo="Info:help/Grab"
  16.  
  17. /* TAGNAME of your SYSOP Feedback message base */
  18. sysopbase=GetClip('SYSOPBASE')
  19.  
  20. /* Your name */
  21. sysop=GetClip('SYSOP')
  22.  
  23. /* Verified user Data */
  24. ucfg="CFG:Guser.dat"
  25.  
  26. /* Non-Secure Inbound directory for users */
  27. indir=addslash(dequote(getclip('INDIR')))'USERS/'
  28.  
  29. /* If RFS is used instead of XfreqSh, maximum config and request    */
  30. /* accounting will take precedence over maxfiles setting            */
  31. rfs=1
  32.  
  33. ViewNew=0
  34.  
  35. /* if NOT using RFS */
  36. freqcmd="run Xfreqsh >LOG:Freq.log CFG:FREQ.cfg"
  37.  
  38. options RESULTS
  39. options failat 99
  40. numeric digits 14
  41. signal on syntax
  42. signal on halt
  43. signal on ioerr
  44. signal on break_c
  45. signal on break_d
  46. pragma("W","NULL")
  47. rpath=addslash(dequote(GetClip('REXXDIR')))
  48.  
  49. if ~show('L',"rexxsupport.library") then
  50.     if ~addlib("rexxsupport.library",0,-30,0) then do
  51.          say "Couldn't access support.library !"
  52.         exit 20
  53.     end
  54.  
  55. log=show('P','ROOFLOG')
  56. /*rfshost=show('P','RFSHOST')   */
  57. mailer=GetCLip('SHELTER')
  58. l_mailer=lower(mailer)
  59. wplport=l_mailer
  60. sv='v'right(v,5)
  61. script="GRAB"
  62. cls  ='\014'  /* WPL */  
  63. cr   ='\r\n'  /* WPL */
  64. nl   ='0a'X   /* REXX */
  65. bs   ='08'x
  66. quote='"'
  67. tmsg="T:GRAB-"pragma('ID')
  68. timeouts=0
  69. parse arg baud port username
  70. btarea=center("GRAB "sv,21)
  71. btitle=center("A WPL Application by Robert Williamson",41)
  72. call send(cls||cr||cr||center('GRAB File Requester 'sv' on $(host.sitename) Line 'port,80)||cr)   
  73. call send(" ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÑÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸ "cr)
  74. call send(" ³°°°°°±±±±±²²²²²ÛÛÛÛÛ²²²²²³"btarea"³²²²²²ÛÛÛÛÛ²²²²²±±±±±°°°°°³ "cr)
  75. call send(" ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´ "cr)
  76. call send(" ³°°°°°±±±±±²²²²²³"btitle"³²²²²²±±±±±°°°°°³ "cr)
  77. call send(" ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÏÍÍÍÍÍÍÍÍÍÍÍÍÍÍ; "cr||cr)
  78. call send(" MAKE SURE your terminal program has the following protocol settings:"cr)
  79. call send(" Zmodem CRC32 with AutoDownLoad ON and ADL Challenge ON."cr)
  80. call send(" Do not waste time guessing filenames, requesting files that are not"cr) 
  81. call send(" in the FileList or which are larger than the allowable free bytes!"cr)
  82. call send(" These are the requirements to GRAB files"cr)
  83.  
  84. if username="" then fname=wpl_prompt(60,cr' Please enter your name: ')
  85.     else fname=strip(username)
  86.  
  87. if fname="" | words(fname)<2 | index(fname,"'") ~=0  | index(fname,"`") ~=0 then do
  88.     call send(cr'Sorry, your first name and last name (sans apostrophes) is required to GRAB files'cr)
  89.     'Set USER FALSE'
  90.     call cleanup()
  91.     exit 0
  92. end
  93.  
  94. xname='$(p.login) 'fname time()
  95. 'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) 'xname'"'
  96. tdomain=translate(fname,"_"," ");address="0:0/0.0"
  97. user_verified=GetVar("VUSER"port,"G")=="TRUE"
  98. call PutLog('Login:'fname tdomain"#"address 'Verified:'user_verified,10,10)
  99.  
  100. notgrabreq=1
  101. if ~rfs then reqfile="0.0.0.0.REQ"
  102. else do
  103.     reqfile=tdomain".GRAB"
  104.     if exists(indir||reqfile) then do
  105.         call send(cr' Found your request list'cr)
  106.         notgrabreq=0
  107.     end
  108.  
  109.     if notgrabreq then do
  110.         AcctFile="LOG:RFSacct/h/"tdomain".0.0.0.0"
  111.         if ~exists(AcctFile) then do
  112.             call Send(' We have No account for you as yet 'fname||cr)
  113.             call Send(' Accounts are only created when you have made requests.'cr)
  114.             if upper(wpl_prompt(30,' Since your are a new user, would you like some more information? (Y/n) '))~="N" then call display_text(newinfo)
  115.         end;else do
  116.             call Send(' You can automate your GRAB sessions by uploading 'tdomain'.GRAB,'cr)
  117.             call Send(' containing the list of files you want, with the UL command.'cr)
  118.         end
  119.     end 
  120.  
  121.     if ~user_verified then do
  122.         if ~verify() then do
  123.             call PutLog(fname' declined verification',10,10)
  124.             user_verified=0
  125.         end;else do
  126.             maxfiles=maxpsessions
  127.             user_verified=1
  128.         end
  129.     end
  130.  
  131.     if notgrabreq then call show_status()
  132.  
  133.     'Set remote.address' tdomain"#"address
  134.     'SetA remote $(remote.address)'
  135.     'Set remote.network FIDO'
  136.     'BeginSession $(remote.address)'
  137.     'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) GRAB session with $(remote.address)"'
  138. end
  139. reqname=indir||reqfile
  140.  
  141. if notgrabreq then do
  142.     if ViewNew then do
  143.         if upper(wpl_prompt(30,' View new files received in the last week? (y/N) '))="Y" then call display_text(newfiles)
  144.     end
  145.     call send(' You can either Browse File Areas and Mark files for DownLoad or'cr)
  146.     call send(' Enter filenames if you know the exact names from the file list'cr)
  147.     dobrowse=upper(wpl_prompt(30,' [B]rowse or [E]nter? (b/E) '))=="B"
  148.     
  149.     if dobrowse then do
  150.         if exists("RPDIR:BROWSE") then do
  151.             address COMMAND 'Browse' baud port availbytes fname
  152.             stat=RC
  153.         end;else if exists(rpath'browse.rexx') then do
  154.             address REXX rpath'browse.rexx' baud port availbytes fname
  155.             stat=RESULT
  156.         end;else do
  157.             call send('Sorry, Browse is not available at the moment'cr)
  158.             stat=1
  159.         end
  160.         call PutLog('Browse returned:'stat,10,10)
  161.         if stat>1 then do
  162.             call cleanup
  163.             exit
  164.         end;else if stat=1 then notgrabreq=0
  165.         else do
  166.             if upper(wpl_prompt(30,' You did not mark any files for download'CR' Do you wish to enter filenames? (Y/n)'))="N" then do
  167.                 call send(' OK, bye'cr)
  168.                 call cleanup
  169.                 exit
  170.             end
  171.         end
  172.     end
  173. end
  174.  
  175. rereq:
  176.     if notgrabreq then call getrequests
  177.     if lostcarrier('request entry') then exit
  178.     if ~notgrabreq then signal getfiles
  179. getstate:
  180.     resp=upper(wpl_prompt(30,' [D]ownload, [R]e-enter requests, [A]bort Grab? '))
  181.     if resp="R" then signal rereq
  182.     else if resp="A" then do
  183.         call PutLog(fname 'aborted',10,10)
  184.         call send(cr||cr' -> Bye, sorry you did not find anything you wanted!'cr||cr)
  185.         call cleanup
  186.         exit
  187.     end
  188.     else if resp~="D" then signal getstate
  189.  
  190. getfiles:
  191. if word(statef(reqname),2) ~= 0 then do
  192.     call send(cls||cr' Please WAIT, now searching for the files you have requested'cr)
  193.     call send(' You have a few seconds to MAKE SURE Zmodem is your default'cr)
  194.     call send(' protocol and that both AutoDownLoad and ADL Challenge are ON.'cr)
  195.     call send(' If you do not have these settings, the transfer will fail.'cr)
  196.     if rfs then do
  197.         host_address=GetClip('DOMAIN')"#"GetClip('HOST.ADDRESS.'GetClip('DOMAIN'))
  198.         address "REXX" rpath'RFS.rexx' wplport port baud host_address reqname user_verified tdomain'#'address fname
  199.     end;else do
  200.         cmd=freqcmd reqfile reqname tdomain'#'address port
  201.         address COMMAND cmd
  202.     end
  203.     call send(cr' Ready! 'cr)
  204.     if lostcarrier('during search') then exit
  205.     Address "LOGPROC" "PutLine 'l_mailer'wplstat"port protpos "ZMODEM"
  206.     call xfer()
  207.     dl=1
  208. end;else do
  209.     call send(cr' No files requested'cr)
  210.     dl=0
  211. end
  212.  
  213. if dl then resp=wpl_prompt(60,cr' Well 'fname', do you want to thank the sysop for these free downloads? y/N ')
  214.     else resp=wpl_prompt(60,cr' Well 'fname', do you want to leave the sysop a message? y/N ')
  215. if upper(resp)="Y" then call feedback
  216.  
  217. call send(cr||cr' -> Bye!'cr||cr)
  218.  
  219. if ~dl then call PutLog('No requests from' fname,10,10)
  220. call cleanup()
  221. exit 0
  222.  
  223. getrequests:
  224. call send(cls)
  225. call send(' Enter filenames (maximum 'maxfiles', NO WILDCARDS!)'cr)
  226. call send(' or a blank line to start transfer.'cr)
  227.  
  228. if ~Open('reqfile',reqname,'A') then do
  229.     if ~Open('reqfile',reqname,'W') then do
  230.         call PutLog("Error opening" reqname,10,10)
  231.         call cleanup
  232.         Exit 10
  233.     end
  234. end
  235. do n=1 to maxfiles
  236.     wantfile=wpl_prompt(60,cr' FILE 'n': ')
  237.     if wantfile="" then leave
  238.     if pos('*',wantfile)>0 then do
  239.         call send(' NO WILDCARDS!'cr)
  240.         if n>1 then n=n-1
  241.         iterate
  242.     end
  243.     else call WriteLN('reqfile',strip(wantfile))
  244.     call PutLog(fname 'requesting:'strip(wantfile),10,10)
  245. end
  246. call close('reqfile')
  247. return
  248.  
  249. xfer:
  250. t='GRAB $(protocol) Sending to 'fname
  251. 'Set req TRUE protocol ZMODEM inbound' indir
  252. if ~rfs then do
  253.     'Set remote.address' tdomain"#"address
  254.     'BeginSession $(remote.address)'
  255. end
  256. 'Set titadr' '"'t'"'
  257. 'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) GRAB sending files to $(remote.address)"'
  258. 'RexxMsg NY "LOGPROC" "PutLine 'l_mailer'wplstat$(line) $(p.protocol) $(protocol)"'
  259. 'SetMailerFlags' '"DN,PN"'
  260. 'XprSetup' 'xprzedzap.library' 'TN,ON,B8,F0,E30,AN,DN,KN,SN,RN,NN,M1024'
  261. 'SetUpDate "CON:0/$($(line).w_offset)/640/130/$(titadr)/AUTO/SCREEN$(pscreen)"'
  262. 'XprSend ""'
  263. 'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) GRAB $(remote.address) $(protocol) Send:$(RC)"'
  264. 'XprClose'
  265. 'SetUpDate NULL'
  266. 'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) GRAB $(remote.address) $(protocol) RC:$(RC)"'
  267. 'EndSession all'
  268. return
  269.  
  270. display_text:
  271. textfile=arg(1)
  272. if ~open('tf',textfile,"R") then do
  273.     call Send(cr'Sorry, unable to find 'textfile||cr)
  274.     call PutLog("Cannot open "textfile,10,10)
  275.     return 0
  276. end
  277. call PutLog('Typing 'textfile' for 'fname,10,10)
  278. call send(cls||cr)
  279. lines=0
  280. do while ~eof('tf')
  281.     if lostcarrier('during text display') then exit
  282.     call send(readln('tf')||cr)
  283.     lines=lines+1
  284.     if lines=24 then do
  285.         lines=0
  286.         if upper(wpl_prompt(60,cr'More(Y,n): '))="N" then do
  287.             call close('tf')
  288.             call send(cr)
  289.             return 0
  290.         end;else do
  291.             call send(copies(bs,12))  
  292.             call send(cls)
  293.         end
  294.     end
  295. end
  296. call close('tf')
  297. call send(cr)
  298. return 0
  299.  
  300. show_status:
  301. if ~open('rcfg',"RAM:RFS.CFG",'r') then
  302.     if ~open('rcfg',"CFG:RFS.CFG",'r') then return 0
  303. call seek('rcfg',-512,'E')
  304. do while ~eof('rcfg')
  305.     z=readln('rcfg')
  306.     if upper(left(word(z,1),3))="MAX" then interpret z
  307. end
  308. call close('rcfg')
  309.  
  310. call send(cls||cr)
  311. AcctFile="LOG:RFSacct/h/"tdomain".0.0.0.0"
  312. if ~exists(AcctFile) then do
  313.     call Send(' Opening new account for 'fname||cr)
  314.     call Send(' Account will be deleted if no requests made.'cr||cr)
  315.     FirstDate=date();LastDate=date()
  316.     NumReqs=0;ReqFiles=0;ReqBytes=0;LastBytes=0;UserCalls=1
  317.     limits="RESET"
  318.     if user_verified then do
  319.         availbytes=(baud*100)
  320.         availsessions=maxpsessions
  321.     end;else do
  322.         availbytes=MaxHBytes
  323.         availsessions=MaxCalls
  324.     end
  325. end;else do
  326.     call open('Acct',AcctFile,'R')
  327.     FirstDate=readln('Acct')
  328.     LastDate =readln('Acct')
  329.     NumReqs  =readln('Acct')
  330.     ReqFiles =readln('Acct')
  331.     ReqBytes =readln('Acct')
  332.     LastBytes=readln('Acct')
  333.     UserCalls=readln('Acct')
  334.     call close('Acct')
  335.     if Date()=LastDate then do
  336.         limits="ACTIVE"
  337.         if user_verified then do
  338.             availbytes=(baud*100)-LastBytes
  339.             availsessions=maxpsessions-UserCalls
  340.         end;else do
  341.             availbytes=MaxHDaily-LastBytes
  342.             availsessions=MaxCalls-UserCalls
  343.         end
  344.     end;else do
  345.         limits="RESET"
  346.         if user_verified then do
  347.             availbytes=(baud*100)
  348.             availsessions=maxpsessions
  349.         end;else do
  350.             availbytes=MaxHBytes
  351.             availsessions=MaxCalls
  352.         end
  353.     end
  354. end
  355. s12=copies(" ",12)
  356. call send(s12' ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸'cr)
  357. call send(s12' ³  Account                :'right_justify(fname" ³",23)||cr)
  358. call send(s12' ³  First Call             :'right_justify(Firstdate" ³",23)||cr)
  359. call send(s12' ³  Last Call              :'right_justify(LastDate" ³",23)||cr)
  360. call send(s12' ³  Number of Requests     :'right_justify(NumReqs" ³",23)||cr)
  361. call send(s12' ³  Files Transfered       :'right_justify(ReqFiles" ³",23)||cr)
  362. call send(s12' ³  Total Bytes Sent       :'right_justify(ReqBytes" ³",23)||cr)
  363. call send(s12' ³  Bytes Sent Last Call   :'right_justify(LastBytes" ³",23)||cr)
  364. call send(s12' ³  Number of Sessions     :'right_justify(Usercalls" ³",23)||cr)
  365. call send(s12' ³  Files available        :'right_justify(maxfiles" ³",23)||cr)
  366. call send(s12' ³  Bytes available        :'right_justify(availbytes" ³",23)||cr)
  367. call send(s12' ³  Remaining Sessions     :'right_justify(availsessions" ³",23)||cr)
  368. call send(s12' ³  Daily limits           :'right_justify(limits" ³",23)||cr)
  369. call send(s12' ³  Total Freeloader Limit :'right_justify(MaxHtotal" ³",23)||cr)
  370. call send(s12' ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;'cr||cr)
  371.  
  372. if ReqBytes>MaxHtotal then do
  373. call send(s12' ÕÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ͸'cr)
  374. call send(s12' ³  FreeLoader Limit Exceeded - Time to REGISTER  ³'cr)
  375. call send(s12' ÔÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ;'cr||cr)
  376. call send(' Just look at what you are missing!'cr||cr)
  377. call display_text(newfiles)
  378. end
  379.  
  380. return
  381.  
  382. /* feedback to sysop */
  383. feedback:
  384. call PutLog('GRAB feedback from 'fname,10,10)
  385. call send(cls||cr' To:                  'sysop)
  386. call send(cr' From:                'fname)
  387. resp=wpl_prompt(60,cr' Subject (Return aborts): ')
  388. if resp="" then do
  389.     call send(cr' Message aborted, why?'cr)
  390.     return 0
  391. end
  392. else subject=strip(resp)
  393.  
  394. call send(cr' Enter your message one line at a time.'cr)
  395. call send(cr' Hit Return to select Save or continue.'cr)
  396.  
  397. call open('smsg',tmsg,"W")
  398. call writech('smsg'," GRAB Feedback to Sysop "resp" from "fname" Posted:"date()" at "time()||nl)
  399. editing=1
  400. line=1
  401. c=0
  402. do while editing
  403.     do while resp ~= ""
  404.         if lostcarrier('during feedback') then leave
  405.         resp=wpl_prompt(200,"-->"line": ")
  406.         if resp ~= "" then do
  407.             chars=writech('smsg',resp||nl)
  408.             c=c+chars
  409.             line=line+1
  410.         end
  411.     end /* hit a blank line */
  412.  
  413.     if lostcarrier('during feedback') then do
  414.         call writech('smsg',fname 'dropped carrier'nl)
  415.         call save_msg
  416.         exit
  417.     end
  418.     if upper(wpl_prompt(120,cr' You entered 'line-1' lines and 'chars' characters (total:'c'), [S]ave/[c]ontinue?'cr))="S" then editing=0
  419. end  /* finished editing */
  420. call save_msg
  421. call send(cr' Message saved, thanks' fname||cr)
  422. return 0
  423.  
  424. save_msg:
  425. call writech('smsg',nl)
  426. call close('smsg')
  427. call PutLog('Saving message from 'fname' in 'sysopbase,10,10)
  428. call send(cr' Saving......')
  429. if exists("RPDIR:Smsg") then do
  430.     cmd=sysopbase tmsg '"'fname'"' '"'sysop'"' subject
  431.     call PutLog('Executing:' cmd,10,10)
  432.     address COMMAND "run >NIL: Smsg" cmd
  433. end;else do
  434.     cmd=rpath'Smsg.rexx' sysopbase tmsg '"'fname'"' '"'sysop'"' subject
  435.     call PutLog('Executing:' cmd,10,10)
  436.     Address "AREXX" cmd
  437. end
  438. address
  439. return
  440.  
  441.  
  442. lostcarrier:
  443.  'CheckCarrier'
  444. if RC=0 then return 0
  445. call PutLog(fname 'dropped carrier during 'arg(1),10,10)
  446. call cleanup
  447. return 1
  448.  
  449. send:
  450. 'Print' quote||arg(1)||quote
  451. 'Send' quote||arg(1)||quote
  452. return
  453.  
  454. wpl_prompt:
  455. 'Print' quote||arg(2)||quote
  456. 'Send' quote||arg(2)||quote
  457. getstring:
  458. 'GetInbound E0 'arg(1)
  459. 'String $(event)'
  460. if upper(RESULT)='CARRIER' then do
  461.     'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) GRAB $(remote.address) Lost Carrier"'
  462.     call PutLog(fname' dropped carrier',10,10)
  463.     call cleanup
  464.     exit
  465. end
  466. if upper(RESULT)='TIMEOUT' then do
  467.     timeouts=timeouts+1
  468.     call Send(cr'Timeout:'timeouts' .....WakeUp!'cr)
  469.     if timeouts>3 then do
  470.         'RexxMsg NY "LOGPROC" "PutLog 'l_mailer'wpl $<time> $(line) GRAB $(remote.address) User Timeout"'
  471.         call PutLog(fname' fell asleep',10,10)
  472.         call Send(cr'Timeout EXIT, 'fname' fell asleep'cr)
  473.         call cleanup
  474.         exit
  475.     end
  476. end
  477. else if upper(RESULT)='LOGIN' then do
  478.     'String $(namebuf)'
  479.     x=(RESULT)
  480. end
  481. else x=""
  482. return x
  483.  
  484.  
  485. verify:
  486. retries=3
  487. if notgrabreq then do
  488.     call Send(cr" If you are a LOCAL caller and wish to be able to DL more than the"cr) 
  489.     call Send(" prescribed limits, please enter your phone number. If you are a new user"cr)
  490.     call Send(" you will be asked to select an 8 character password. You MUST remember"cr)
  491.     call Send(" it, as it will be expected every time you use Grab's CBV."cr||cr)
  492.  
  493.     call Send(" If you are a LONG-DISTANCE caller, and have made an arrangement with the"cr)
  494.     call Send(" Sysop, enter X instead of Y or N, and enter your password when asked."cr) 
  495. end
  496. resp=upper(wpl_prompt(120," Do you wish to be verified? (Y/n) "))
  497. if resp="X" then isdistant=1
  498. else isdistant=0
  499. if resp="N" then return 0
  500.  
  501. if isdistant then do
  502.     phonenumber=wpl_prompt(120," Enter access number: ")
  503.     if ~find_user(phonenumber) then do
  504.         call Send(" Invalid access number, sorry"cr)
  505.         return 0
  506.     end
  507.     if ~getpassword(password) then do
  508.         call send(cr||cr'Too bad'cr)
  509.         call PutLog(fname ' bad LD password',10,10)
  510.         'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.password) BAD"'
  511.         call cleanup
  512.         exit
  513.     end;else do
  514.         status=fname' verified'
  515.         'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.status)' status' $(p.password) OK"'
  516.         call PutLog(status,10,10)
  517.         return 1
  518.     end
  519. end;else do
  520.     phonenumber=""
  521.     do i=1 to retries
  522.         resp=compress(wpl_prompt(120," Enter your local phone number: "),'- ')
  523.         if ~datatype(resp,'NUMERIC') then do
  524.             call Send(' Wierd number, 'retries-i' trys left'cr)
  525.             iterate
  526.         end
  527.         if length(resp)~=7 | substr(resp,2,2)="11" | left(resp,1)="0" then do
  528.             call Send(' Illegal, Invalid or Long Distance number, 'retries-i' trys left'cr)
  529.             iterate
  530.         end;else do
  531.             phonenumber=resp
  532.             leave
  533.         end
  534.     end
  535.     if phonenumber="" then do
  536.         call send(' You blew your chance!'cr)
  537.         call send(' You may still use GRAB, but you will limited in number of files'cr)
  538.         call send(' and total bytes you can download'cr)
  539.         return 0
  540.     end
  541.  
  542.     if find_user(phonenumber) then call send(' If you have forgotten your password, leave me a NOTE with your phone number.'cr)
  543.     else do
  544.         call send(' Opening new user account'cr)
  545.         if ~set_password() then do
  546.             call send(' You blew your chance!'cr)
  547.             return 0
  548.         end
  549.     end
  550.         
  551.  
  552.     call Send(" The system will call you back in a few moments. Your should enable"cr)
  553.     call Send(" autoanswer with ATS0=1 or type ATA when you see the RING."cr)
  554.     call Send(" You must enter your password when asked."cr) 
  555.     if upper(wpl_prompt(30," The system will now hangup and call you back at "phonenumber", OK? (Y/n) "))="N" then do
  556.         call send(' You blew your chance'cr)
  557.         return 0
  558.     end
  559.  
  560.     pnum="ATDT"phonenumber"|"
  561.     do i=1 to retries
  562.         status='CBV Dialing 'fname', try:'i
  563.         'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.status)' status '$(p.number)' phonenumber '$(p.response)"'
  564.         call PutLog(status,10,10)
  565.         call delay(60)
  566.         if mdmcmd(30,'$(hangupstring)','OK') then do
  567.             call delay(60)
  568.             if mdmcmd(5,'$(initstring)','OK') then do
  569.                 call delay(60)
  570.                 if mdmcmd(120,pnum,'CONNECT') then do
  571.                     'ModemClear'
  572.                     status='Reconnected to 'fname' on try 'i', getting password'
  573.                     'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.status)' status '$(p.response) CONNECT"'
  574.                     call PutLog(status,10,10)
  575.                     if ~getpassword(password) then do
  576.                         call send(cr||cr'Too bad'cr)
  577.                         call PutLog(fname ' bad password',10,10)
  578.                         'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.password) BAD"'
  579.                         call cleanup
  580.                         exit
  581.                     end;else do
  582.                         status=fname' verified'
  583.                         'RexxMSG NY LOGPROC "PutLine 'l_mailer'wplstat$(line) $(p.status)' status' $(p.password) OK"'
  584.                         call PutLog(status,10,10)
  585.                         return 1
  586.                     end
  587.                 end;else do
  588.                     'Print "No response to dial\n"'
  589.                     iterate
  590.                 end
  591.             end;else do
  592.                 'Print "Cannot reinit\n"'
  593.                 iterate
  594.             end
  595.         end;else do
  596.             'Print "Cannot hangup\n"'
  597.             iterate
  598.         end
  599.     end
  600.     call PutLog('Unable to contact 'fname' @ 'phonenumber,10,10)
  601.     if ~open('um',"LOG:RFSacct/h/"tdomain".0.0.0.0.m",'A') then do
  602.         if ~open('um',"LOG:RFSacct/h/"tdomain".0.0.0.0.m",'W') then do
  603.             call putlog('Unable to inform user',10,10)
  604.             call cleanup
  605.             exit 0
  606.         end
  607.     end
  608. end
  609. call writeln('um'," Call Back Verifier Report on "date()" at "time())
  610. call writeln('um'," After three attempts, we were unable to connect with you at" phonenumber".")
  611. call writeln('um'," Either the number given was incorrect or is Long Distance from this exchange.")
  612. call writeln('um'," If you are a LONG-DISTANCE caller you may make an arrangement with the")
  613. call writeln('um'," Sysop for a password to enable more generous limits.") 
  614.  
  615. call close('um')
  616. call PutLog('Posted failure to connect message to user',10,10)
  617. call cleanup
  618. exit 0
  619.  
  620. mdmcmd:
  621. 'Clear event lastresponse'
  622. 'ModemClear'
  623. 'SmartSend 'arg(2)
  624. call delay(100)
  625. 'GetResponse' arg(1)
  626. 'String $(event)'
  627. return(upper(RESULT)==arg(3))
  628.  
  629.  
  630. getpassword:
  631. 'ModemClear'
  632. call delay(60)
  633. call send(cr||cr' CallBack Verifier 'sv||cr)
  634. do i=1 to retries
  635.     if lostcarrier('password request') then exit
  636.     if upper(wpl_prompt(120," Password: "))~=arg(1) then call send(' Wrong, 'retries-i' trys left'cr)
  637.     else do
  638.         call send(' Ok!'cr)
  639.         call SetVar("VUSER"port,'TRUE',"G")
  640.         return 1
  641.     end
  642. end
  643. return 0
  644.  
  645. set_password:
  646. call send('  You must select a password to use everytime you wish to be verified'cr)
  647. call send('  If you forget your password, you will not get extended access'cr)
  648. do i=1 to retries
  649.     password=""
  650.     if lostcarrier('new password request') then exit
  651.     resp=upper(wpl_prompt(120," Select an 8 character Password: "))
  652.     if length(resp) ~=8 then do
  653.         call send(' Invalid format, 'retries-i' trys left'cr)
  654.         call send(' User failed counting test'cr)
  655.     end;else do
  656.         password=strip(resp)
  657.         call delay(20)
  658.         if upper(wpl_prompt(120,' Ok, enter it again:'))~=password then do
  659.             call send(' Does not match!'cr)
  660.             call send(' User failed memory test.'cr)
  661.             iterate
  662.         end;else do
  663.             if ~open('u',ucfg,'A') then do
  664.                 if ~open('u',ucfg,'W') then do
  665.                     call PutLog('Unable to open 'ucfg,10,10)
  666.                     call send(cr' System error'cr)
  667.                     exit
  668.                 end
  669.             end
  670.             call writeln('u',phonenumber password fname)
  671.             call close('u')
  672.             address COMMAND "Sort" ucfg ucfg
  673.             call PutLog(fname' @ 'phonenumber' selected a password',10,10)
  674.             call send(cr' Password accepted'cr)
  675.             call send(cr' Do not ever forget it!'cr)
  676.             return 1
  677.         end
  678.     end
  679. end
  680. return 0
  681.  
  682.  
  683. find_user:
  684. call delete("T:upw")
  685. address COMMAND "Fsearch >t:upw" ucfg arg(1)
  686. call open('p',"T:upw",'R')
  687. udat=readln('p')
  688. call close('p')
  689. if left(udat,2)="!@" then return 0
  690. parse VAR udat unum upw uname
  691. if upper(uname)=upper(fname) then do
  692.     password=upw
  693.     return 1
  694. end;else do
  695.     call send(copies(cr||cr' ***** ILLEGAL LOGIN *****'||'07'x||cr||cr,5))
  696.     call PutLog(fname' impersonating 'uname,10,10)
  697.     exit
  698. end
  699. return 0
  700.  
  701. /* get filename */
  702. get_fn:
  703. if LastPos('/',arg(1))~=0 then return SubStr(arg(1),LastPos('/',arg(1))+1)
  704. else if LastPos(':',arg(1))~= 0 then return SubStr(arg(1),LastPos(':',arg(1))+1)
  705. else return arg(1)
  706.  
  707. /* align text to right of field  adding spaces or trucating on left to fit   */
  708. right_justify:
  709. if length(arg(1))>arg(2) then return (right(arg(1),arg(2)))
  710. else return (copies(" ",arg(2)-length(arg(1)))||arg(1))
  711.  
  712. PutLog:  procedure expose log script
  713. if ~log then do
  714.      'RexxMsg RN "LOGPROC" "Putlog 'l_mailer'wpl $<time> $(line) 'script':' arg(1)
  715. end;else do
  716.     if arg(2) > GetClip('LOGLEVEL') then return 0
  717.     address 'ROOFLOG' 'logline' left(time(),5) script': 'arg(1)
  718.     address
  719. end
  720. return 0
  721.  
  722. addslash:
  723. curr=arg(1)
  724. select
  725.     when right(curr,1)=":" then nop
  726.     when right(curr,1)="/" then nop
  727.     otherwise curr=curr"/"
  728. end
  729. return curr
  730.  
  731. /* a useful procedure by Walt Sullivan    */
  732. dequote:
  733. parse arg thing
  734. parse var thing '"' unq_thing '"'
  735. if unq_thing ~= "" then return unq_thing
  736. return thing
  737.  
  738. lower:
  739. return(bitor(arg(1),'20'x))
  740.  
  741. cleanup:
  742. call delete(reqname)
  743. call close('tf')
  744. return 0
  745. break_c:
  746. break_d:
  747. PutLog('User abort',10,10)
  748. call cleanup
  749. exit 10
  750. novalue: 
  751. call template_oops "Novalue" sigl
  752. syntax:
  753. call template_oops "Syntax(RC=" RC ")" sigl RC
  754. failure:
  755. call template_oops "Failure(RC=" RC ")" sigl
  756. ioerr:
  757. call template_oops "IOErr" sigl
  758. halt:
  759. call template_oops "Halt" sigl
  760.  
  761. template_oops:
  762. parse arg what badline code
  763. if code ~= "" then PutLog('ERR: Line 'badline what errortext(code),10,10)
  764. else PutLog('ERR: Line' badline what,10,10)
  765. PutLog('ERR: Line 'badline':'strip(sourceline(badline)),10,10)
  766. call cleanup
  767. exit(40)
  768. /**/
  769.